home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
PGM_TOOL
/
PREVIEW
/
CLP2DLFI
/
WINBROWS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-11-10
|
9KB
|
352 lines
unit Winbrows;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DBFserver, StdCtrls, VBXCtrl, Sxbrow, CommonCode;
type
TWinBrowse = class(TForm)
dbfBrowse: TSixbrowse;
Button1: TButton;
OpenDialog1: TOpenDialog;
flist: TComboBox;
Label1: TLabel;
Button2: TButton;
strlist: TComboBox;
taglist: TComboBox;
srchfor: TEdit;
infld: TComboBox;
Label3: TLabel;
Label4: TLabel;
recnum: TLabel;
oftot: TLabel;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure flistClick(Sender: TObject);
procedure taglistClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure infldClick(Sender: TObject);
procedure srchforKeyPress(Sender: TObject; var Key: Char);
procedure dbfBrowseKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure dbfBrowseEditWhen(Sender: TObject; var nCol: Integer;
var cField: TBasicString; var lCancel: Integer);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
fstruct:DBFstruct;
CanModify:boolean;
alist:array [1..MaxDBFs] of string[15];
acnt:integer;
TagDat:TagInfo;
BrowseName:string[20];
BrowseAlias:oDB;
procedure FillBrowse(UseDBF:string);
procedure DoSearch;
public
{ Public declarations }
procedure OpenNow(ByAlias:string);
end;
var
WinBrowse: TWinBrowse;
implementation
{$R *.DFM}
procedure TWinBrowse.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TWinBrowse.FillBrowse(UseDBF:string);
var ii,jj:integer;
tt:string;
begin
if Gen.CantView(CoreFile(UseDBF)) then begin
OKBox('Access Denied: '+upper(usedbf));
exit;
end;
if not Gen.CanBrowse then begin
if not Gen.ModifyOK(CoreFile(UseDBF)) then begin
OKBox('Not Available, See ''Status'' For List Of Valid Files');
exit
end;
end;
if not dbIsClosed(BrowseAlias) then dbClose(BrowseAlias);
if not dbuse(BrowseAlias,UseDBF) then exit;
Caption:='Browse: '+upper(CoreFile(UseDBF));
dbfbrowse.dbf:=BrowseAlias.Area;
dbfbrowse.ntx:=1;
BrowseAlias.GetDBFstruct(fstruct);
taglist.enabled:=true;
strlist.enabled:=true;
srchfor.enabled:=true;
infld.enabled:=true;
strlist.clear;
strlist.items.add('DataBase Structure');
with fstruct do begin
for ii:=1 to fcount do begin
tt:=padr(fname[ii],13)+' '+ftype[ii]+' '+transform(fwidth[ii],'999');
if fdecs[ii]>0 then begin
tt:=tt+', '+ltrim(transform(fdecs[ii],'999'));
end;
strlist.items.add(tt);
end;
end;
strlist.itemindex:=0;
BrowseAlias.gotop;
with fstruct, dbfBrowse do begin
Cols:=fcount;
autobrowse:=true;
tt:='';
infld.clear;
infld.items.add('Use Index');
CanModify:=Gen.CanBrowseModify;
if not CanModify then begin
if Gen.ModifyOK(CoreFile(UseDBF)) then CanModify:=true;
end;
for ii:=0 to fcount-1 do begin
jj:=length(fname[ii+1]);
if fwidth[ii+1]>jj then jj:=fwidth[ii+1];
if jj>255 then jj:=255;
ColWidth[ii]:=jj;
ColField[ii]:=fname[ii+1];
if (jj+length(tt))<255 then begin
tt:=tt+padr(fname[ii+1],jj);
infld.items.add('In '+fname[ii+1]);
end;
end;
infld.itemindex:=0;
LoadTags(BrowseAlias,TagDat);
taglist.clear;
if TagDat.TagCnt>0 then begin
for ii:=1 to TagDat.tagcnt do taglist.items.add('By '+TagDat.keys[ii]);
taglist.itemindex:=0;
end;
taglist.items.add('Natural Order');
row:=1;
col:=1;
header:=tt;
ii:=row; { leave these in so that row,col can be accessed from debugger }
ii:=col;
recnum.caption:='Row '+inttostr(row);
oftot.caption:='Of '+inttostr(BrowseAlias.reccount);
end;
dbfbrowse.action:=2;
srchfor.setfocus;
end;
procedure TWinBrowse.FormClose(Sender: TObject; var Action: TCloseAction);
begin
fstruct.free;
TagDat.free;
if not dbIsClosed(BrowseAlias) then dbClose(BrowseAlias);
Gen.ReleaseWin(self);
action:=caFree;
end;
procedure TWinBrowse.FormCreate(Sender: TObject);
var ii,jj:integer;
tt:string;
begin
fstruct:=DBFstruct.Create;
TagDat:=TagInfo.Create;
BrowseAlias:=Nil;
top:=0;
left:=0;
width:=605;
height:=374;
centerhoriz(self);
Gen.AddWin('Browse',self);
jj:=0;
acnt:=0;
for ii:=1 to 120 do begin
DoEvents2;
tt:=dbSelectArea(ii);
if not empty(tt) then begin
pp(acnt);
alist[acnt]:=tt;
end else begin
pp(jj); { exit after finding 10 empty areas }
if jj>10 then break;
end;
end;
if acnt>0 then begin
flist.clear;
flist.items.add(' Currently Open');
for ii:=1 to acnt do begin
flist.items.add(alist[ii]);
end;
flist.itemindex:=0;
end;
infld.clear;
srchfor.text:='';
taglist.enabled:=false;
strlist.enabled:=false;
srchfor.enabled:=false;
infld.enabled:=false;
BrowseName:='Browse '+inttostr(Gen.MiscWinCnt+1);
end;
procedure TWinBrowse.OpenNow(ByAlias:string);
var ii,jj:integer;
begin
ByAlias:=upper(ByAlias);
if acnt>0 then begin
jj:=0;
for ii:=1 to acnt do begin
if ByAlias=alist[ii] then begin
jj:=ii;
break;
end;
end;
if jj>0 then begin
flist.itemindex:=jj;
FillBrowse(DBFname[jj]);
end;
end;
end;
procedure TWinBrowse.flistClick(Sender: TObject);
var ii,jj:integer;
begin
if flist.itemindex>0 then begin
jj:=0;
for ii:=1 to acnt do begin
if flist.items[flist.itemindex]=alist[ii] then begin
jj:=ii;
break;
end;
end;
if jj>0 then FillBrowse(DBFname[jj]);
end;
srchfor.setfocus;
end;
procedure TWinBrowse.taglistClick(Sender: TObject);
begin
if taglist.itemindex=(taglist.items.count-1) then begin
dbfbrowse.ntx:=0; { by record number }
button3.caption:='&Go To Row';
end else begin
dbfbrowse.ntx:=taglist.itemindex+1;
button3.caption:='&Search For';
end;
dbfbrowse.action:=2;
srchfor.setfocus;
end;
procedure TWinBrowse.Button2Click(Sender: TObject);
var tt:string;
ii:integer;
begin
with opendialog1 do begin
initialdir:='\ACCTING\JCDAT';
if pin('ACCTTEST',upper(gen.rootdir)) then
initialdir:='\ACCTTEST\JCDAT';
execute;
tt:=opendialog1.filename;
end;
if fileexists(tt) then begin
ii:=pos('.',tt);
if ii>1 then tt:=copy(tt,1,ii-1);
FillBrowse(tt);
end;
end;
procedure TWinBrowse.infldClick(Sender: TObject);
begin
dbfbrowse.setfocus;
end;
procedure TWinBrowse.DoSearch;
var ii:integer;
tdate:longint;
tt,tt2,tdbl:string;
begin
if infld.itemindex=0 then begin
if srchfor.text='TOP' then BrowseAlias.gotop
else if pos('BOT',srchfor.text)=1 then BrowseAlias.gobottom else
begin
if taglist.itemindex<taglist.items.count-1 then
BrowseAlias.seek(srchfor.text) else
begin
tdate:=strtoint(transform(procdbl(srchfor.text),'999999'));
if (tdate>0) and (tdate<=BrowseAlias.lastrec) then begin
BrowseAlias.go(tdate);
end;
end;
end;
end else begin
ii:=infld.itemindex;
with fstruct do begin
tt:=srchfor.text;
MouseWait;
if ftype[ii]='C' then begin
if (pin(tt,upper(BrowseAlias.s(fname[ii])))) and
(not BrowseAlias.eof)
then BrowseAlias.skip;
while not BrowseAlias.eof do begin
if pin(tt,upper(BrowseAlias.s(fname[ii]))) then break;
BrowseAlias.skip;
end;
end;
if ftype[ii]='N' then begin
tdbl:=ltrim(transform(procdbl(tt),'999999999.9999'));
tt2:=transform(BrowseAlias.f(fname[ii]),'999999999.9999');
if (pin(tt,tt2)) and (not BrowseAlias.eof) then BrowseAlias.skip;
while not BrowseAlias.eof do begin
tt2:=transform(BrowseAlias.f(fname[ii]),'999999999.9999');
if pin(tt,tt2) then break;
BrowseAlias.skip;
end;
end;
if ftype[ii]='D' then begin
tdate:=ctod(tt);
if (tdate=BrowseAlias.d(fname[ii])) and
(not BrowseAlias.eof) then BrowseAlias.skip;
while not BrowseAlias.eof do begin
if tdate=BrowseAlias.d(fname[ii]) then break;
BrowseAlias.skip
end;
end;
MouseGo;
end;
end;
dbfbrowse.action:=2;
dbfbrowse.setfocus;
end;
procedure TWinBrowse.srchforKeyPress(Sender: TObject; var Key: Char);
begin
if getret(key) then begin
DoSearch;
end;
end;
procedure TWinBrowse.dbfBrowseKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
recnum.caption:='Row '+inttostr(BrowseAlias.recno);
oftot.caption:='Of '+inttostr(BrowseAlias.reccount);
end;
procedure TWinBrowse.dbfBrowseEditWhen(Sender: TObject; var nCol: Integer;
var cField: TBasicString; var lCancel: Integer);
begin
if not CanModify then lCancel:=-1;
end;
procedure TWinBrowse.Button3Click(Sender: TObject);
begin
if not empty(srchfor.text) then DoSearch;
end;
end.